perm filename BROWSE.NEW[TIM,LSP] blob
sn#681180 filedate 1982-10-07 generic text, type T, neo UTF8
(FILECREATED " 7-OCT-82 15:58:40" ε∧{PHYLUM⎇<GABRIEL>BROWSE.;5ε↓ 5753
changes to: (VARS BROWSECOMS)
(FNS RANDOMIZE)
previous date: " 7-OCT-82 15:28:46" {PHYLUM⎇<GABRIEL>BROWSE.;3)
(* Copyright (c) 1982 by RPG)
(PRETTYCOMPRINT BROWSECOMS)
(RPAQQ εαBROWSECOMSε↓ ((FNS * BROWSEFNS)
(GLOBALVARS RAND)
(LOCALVARS . T)))
(RPAQQ εαBROWSEFNSε↓ (INVESTIGATE BROWSE MATCH RANDOMIZE RANDOM SEED INIT))
(DEFINEQ
(ε∧INVESTIGATEε↓
(LAMBDA (UNITS PATS) εβ(* JonL " 7-OCT-82 15:21")ε↓
(PROG NIL
LOOP(COND
((NULL UNITS)
(RETURN NIL)))
(PROG (P)
(SETQ P (GETPROP (CAR UNITS)
(QUOTE PATTERN)))
LOOP(COND
((NULL P)
(RETURN NIL)))
(PROG (PTS)
(SETQ PTS PATS)
LOOP(COND
((NULL PTS)
(RETURN NIL)))
(εαMATCHε↓ (CAR PTS)
(CAR P)
NIL)
(SETQ PTS (CDR PTS))
(GO LOOP))
(SETQ P (CDR P))
(GO LOOP))
(SETQ UNITS (CDR UNITS))
(GO LOOP))))
(ε∧BROWSEε↓
(LAMBDA NIL
(εαSEEDε↓)
(εαINVESTIGATEε↓ (εαRANDOMIZEε↓ (εαINITε↓ 100 10 4
(QUOTE ((A A A B B B B A A A A A B B A A A)
(A A B B B B A A (A A)
(B B))
(A A A B (B A)
B A B A)))))
(QUOTE ((*A ?B *B ?B A *A A *B *A)
(*A *B *B *A (*A)
(*B))
(? ? *(B A)* ? ?))))))
(ε∧MATCHε↓
(LAMBDA (PAT DAT ALIST)
(COND
((NULL PAT)
(NULL DAT))
((NULL DAT)
NIL)
((OR (EQ (CAR PAT)
(QUOTE ?))
(EQ (CAR PAT)
(CAR DAT)))
(εαMATCHε↓ (CDR PAT)
(CDR DAT)
ALIST))
((EQ (CAR PAT)
(QUOTE *))
(OR (εαMATCHε↓ (CDR PAT)
DAT ALIST)
(εαMATCHε↓ (CDR PAT)
(CDR DAT)
ALIST)
(εαMATCHε↓ PAT (CDR DAT)
ALIST)))
(T (COND
((ATOM (CAR PAT))
(COND
((EQ (NTHCHAR (CAR PAT)
1)
(QUOTE ?))
((LAMBDA (VAL)
(COND
(VAL (εαMATCHε↓ (CONS (CDR VAL)
(CDR PAT))
DAT ALIST))
(T (εαMATCHε↓ (CDR PAT)
(CDR DAT)
(CONS (CONS (CAR PAT)
(CAR DAT))
ALIST)))))
(ASSOC (CAR PAT)
ALIST)))
((EQ (NTHCHAR (CAR PAT)
1)
(QUOTE *))
((LAMBDA (VAL)
(COND
(VAL (εαMATCHε↓ (APPEND (CDR VAL)
(CDR PAT))
DAT ALIST))
(T ((LAMBDA (G0024 G0025 G0026)
(PROG (L E D)
(PROGN (SETQ L G0024)
(SETQ E G0025)
(SETQ D G0026))
LOOP(COND
((NULL E)
(RETURN NIL)))
(COND
((εαMATCHε↓ (CDR PAT)
D
(CONS (CONS (CAR PAT)
L)
ALIST))
(RETURN T)))
((LAMBDA (G0024 G0025 G0026)
(PROGN (SETQ L G0024)
(SETQ E G0025)
(SETQ D G0026)))
(NCONC L (CONS (CAR D)
NIL))
(CDR E)
(CDR D))
(GO LOOP)))
NIL
(CONS NIL DAT)
DAT))))
(ASSOC (CAR PAT)
ALIST)))))
(T (AND (NOT (ATOM (CAR DAT)))
(εαMATCHε↓ (CAR PAT)
(CAR DAT)
ALIST)
(εαMATCHε↓ (CDR PAT)
(CDR DAT)
ALIST))))))))
(ε∧RANDOMIZEε↓
[LAMBDA (L) εβ(* lmm " 7-OCT-82 15:43")ε↓
(PROG (A)
(SETQ A NIL)
LOOP(COND
((NULL L)
(RETURN A)))
([LAMBDA (N)
(COND
((IEQP N 0)
(SETQ A (CONS (CAR L)
A))
(SETQ L (CDR L)))
(T ([LAMBDA (G0021 G0022)
(PROG (N X)
(PROGN (SETQ N G0021)
(SETQ X G0022))
LOOP[COND
((IEQP N 1)
(RETURN (PROGN (SETQ A (CONS (CADR X)
A))
(RPLACD X (CDDR X]
([LAMBDA (G0021 G0022)
(PROGN (SETQ N G0021)
(SETQ X G0022]
(IDIFFERENCE N 1)
(CDR X))
(GO LOOP]
N L]
(REMAINDER (εαRANDOMε↓)
(LENGTH L)))
(GO LOOP])
(ε∧RANDOMε↓
(LAMBDA NIL
(RPAQ RAND (REMAINDER (ITIMES RAND 17)
251))))
(ε∧SEEDε↓
(LAMBDA NIL
(RPAQ RAND 21)))
(ε∧INITε↓
(LAMBDA (N M NPATS IPATS)
((LAMBDA (IPATS)
(PROG (P)
(SETQ P IPATS)
LOOP(COND
((NULL (CDR P))
(RETURN (RPLACD P IPATS))))
(SETQ P (CDR P))
(GO LOOP))
((LAMBDA (G0012 G0013 G0014 G0015)
(PROG (N I NAME A)
(PROGN (SETQ N G0012)
(SETQ I G0013)
(SETQ NAME G0014)
(SETQ A G0015))
LOOP(COND
((IEQP N 0)
(RETURN A)))
(SETQ A (CONS NAME A))
(εαFORε↓ I εαFROMε↓ I εαTOε↓ 1 εαBYε↓ -1 εαDOε↓ (PUTPROP NAME (GENSYM)
NIL)
εαFINALLYε↓ (RETURN NIL))
(PUTPROP NAME (QUOTE PATTERN)
((LAMBDA (G0016 G0017 G0018)
(PROG (I IPATS A)
(PROGN (SETQ I G0016)
(SETQ IPATS G0017)
(SETQ A G0018))
LOOP(COND
((IEQP I 0)
(RETURN A)))
(SETQ A (CONS (CAR IPATS)
A))
((LAMBDA (G0016 G0017)
(PROGN (SETQ I G0016)
(SETQ IPATS G0017)))
(IDIFFERENCE I 1)
(CDR IPATS))
(GO LOOP)))
NPATS IPATS NIL))
(εαFORε↓ J εαFROMε↓ (IDIFFERENCE M I) εαTOε↓ 1 εαBYε↓ -1 εαDOε↓ (PUTPROP NAME (GENSYM)
NIL)
εαFINALLYε↓ (RETURN NIL))
((LAMBDA (G0012 G0013 G0014)
(PROGN (SETQ N G0012)
(SETQ I G0013)
(SETQ NAME G0014)))
(IDIFFERENCE N 1)
(COND
((IEQP I 0)
M)
(T (IDIFFERENCE I 1)))
(GENSYM))
(GO LOOP)))
N M (GENSYM)
NIL))
(SUBST NIL NIL IPATS))))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS RAND)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(DECLARE: DONTCOPY (PUTPROPS BROWSE COPYRIGHT ("RPG" 1982)))
(DECLARE: DONTCOPY
(FILEMAP (NIL (429 5553 (INVESTIGATE 439 . 1053) (BROWSE 1055 . 1400) (MATCH 1402 . 3155) (RANDOMIZE
3157 . 3907) (RANDOM 3909 . 3990) (SEED 3992 . 4036) (INIT 4038 . 5551)))))
STOP